PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/exarray.com/XGENHEAP.PAS

Pascal/Delphi Source File | 1989-08-19 | 6.2 KB | 219 lines

Unit XGenHeap; {ExtendedArray-Based Generic Heaps}
{$R-,O+,S-}
{$B-}
    {*MUST* ensure Short-Circuit Boolean Evaluation!}

{Introduces the Generic Heap variant of the ExtendedArray Object}

{ XGenericHeaps are indexed 1..MaxElements, rather then 0..MaxElements-1 }

{ XGenericHeaps are bigger than their MaxArray based cousins, but otherwise }
{ completely interchangeable.  NOTE: Even though Copy is implemented, I do  }
{ NOT anticipate it often being possible to use it!                         }

{ PERFORMANCE NOTES: SiftUp works quite nicely, but sad to say SiftDown is }
{                    REALLY BAD.  Thus, sorting performance degrades quite }
{                    rapidly in proportion to the number of Lobes on Disk. }
{                    See comments in XHeaps for more.                      }

INTERFACE

Uses ExtArray,SrtFuncs,FlexPntr;

Type
  XGenericHeap = Object (ExtendedArray)

                Greater : SortFunc;

                Procedure Init (MaxElements : LongInt; ElementSize : Word;
                                GreaterFunc : SortFunc);

                { Accept, Retrieve, and Swap are only redefined to      }
                { implement the 1..MaxElement indexing needed for Heaps }

                Procedure Accept (Var El; Index : LongInt; Size : Word);

                Procedure Retrieve (Var El; Index : LongInt; Size : Word);

                Procedure Swap (I,J : LongInt);

                Procedure SiftDown (I,J : LongInt);

                                   { While I can think of No reason to  }
                                   { Use SiftDown externally, there may }
                                   { be a reason, so I have exported it }

                Procedure SiftUp (Var El; Index : LongInt; Size : Word);

                                 { SiftUp can be used in place of Accept }
                                 { In order to Create/Maintain a Heap as }
                                 { a Heap while adding elements, thus    }
                                 { allowing the use of Sort instead of   }
                                 { HeapSort which structures a Heap by   }
                                 { using BuildHeap.                      }

                Procedure BuildHeap;

                                 { Creates the Heap structure from }
                                 { the ground up.                  }

                Procedure Sort;

                          { Sorts a Heap into Ascending order    }
                          { Assumes HEAP is built or maintained. }

                Procedure ChangeSort (NewSort : SortFunc);

                          { Permits the changing of sorting methods   }
                          { such as might be required for sorting     }
                          { records by a different field, for example }

                { NOTE: This will require use of HeapSort to re-sort. }

                Procedure HeapSort;

                          { Sorts a Heap into Ascending order     }
                          { Assumes nothing about Heap structure. }

                Procedure Copy (From : XGenericHeap);

                          { Target Heap *MUST* be initialized  }
                          { to EXACTLY same parameters as From }

             End;


IMPLEMENTATION

Procedure XGenericHeap.Init;
Begin
  Greater := GreaterFunc;
  ExtendedArray.ManualInit (MaxElements,ElementSize,56000)
End;

Procedure XGenericHeap.Accept (Var El; Index : LongInt; Size : Word);
Begin
  ExtendedArray.Accept (El,Index-1,Size)
End;

Procedure XGenericHeap.Retrieve (Var El; Index : LongInt; Size : Word);
Begin
  ExtendedArray.Retrieve (El,Index-1,Size);
End;

Procedure XGenericHeap.Swap (I,J : LongInt);
Begin
  ExtendedArray.Swap (I-1,J-1)
End;

Procedure XGenericHeap.SiftDown (I,J : LongInt);
Var
  K     : LongInt;
  T1,T2 : FlexPtr;
Begin
  If I <= J Div 2  {J = "HeapLength"}
    Then
      Begin
        GetMem (T1,SizeOf(FlexCount)+ElemSize);
        GetMem (T2,SizeOf(FlexCount)+ElemSize);
        If (1+2*I) > J
          Then
            K := 2*I
          Else
            Begin
              Retrieve (T1^.Flex,2*I,ElemSize);
              Retrieve (T2^.Flex,1+2*I,ElemSize);
              If (Greater (T1^.Flex,T2^.Flex))
                Then
                  K := 2*I
                Else
                  K := 1+2*I
            End;
        Retrieve (T1^.Flex,K,ElemSize);
        Retrieve (T2^.Flex,I,ElemSize);
        If (Greater (T1^.Flex,T2^.Flex))
          Then
            Begin
              Swap (K,I);
              SiftDown (K,J)
            End;
        FreeMem (T1,SizeOf(FlexCount)+ElemSize);
        FreeMem (T2,SizeOf(FlexCount)+ElemSize)
      End
End;

Procedure XGenericHeap.SiftUp (Var El; Index : LongInt; Size : Word);
Var
  J,K   : LongInt;
  T1,T2 : FlexPtr;
Begin
  Accept (El,Index,Size);
  If Index >= 2 Then
    Begin
      GetMem (T1,SizeOf(FlexCount)+ElemSize);
      GetMem (T2,SizeOf(FlexCount)+ElemSize);
      K := Index;
      J := K Div 2;
      Retrieve (T1^.Flex,K,ElemSize);
      Retrieve (T2^.Flex,J,ElemSize);
      While ((J > 0) and (Greater (T1^.Flex,T2^.Flex))) do
        Begin
          Swap (K,J);
          K := J;
          J := K Div 2;
          If J > 0
            Then
              Begin
                Retrieve (T1^.Flex,K,ElemSize);
                Retrieve (T2^.Flex,J,ElemSize)
              End
        End;
      FreeMem (T1,SizeOf(FlexCount)+ElemSize);
      FreeMem (T2,SizeOf(FlexCount)+ElemSize)
    End
End;

Procedure XGenericHeap.BuildHeap;
Var
  I: LongInt;
Begin
  For I := MaxEl Div 2 DownTo 1 do SiftDown (I,MaxEl)
End;

Procedure XGenericHeap.ChangeSort (NewSort : SortFunc);
Begin
  Greater := NewSort
End;

Procedure XGenericHeap.Sort;  {Assumes HEAP is built or maintained}
Var
  I : LongInt;
Begin
  For I := MaxEl DownTo 2 do
    Begin
      Swap (1,I);

      GoToXY (12,13);
      Write (100000-I);
      ClrEol;

      SiftDown (1,I-1)
    End
End;

Procedure XGenericHeap.HeapSort;
Var
  I : LongInt;
Begin
  BuildHeap;
  Sort
End;

Procedure XGenericHeap.Copy;
Begin
  Greater := From.Greater;
  ExtendedArray.Copy (From)
End;

BEGIN
END.